home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / PET / S-Super PET / (s)t4.d64 / FIB.ASM < prev    next >
Assembly Source File  |  2009-01-18  |  6KB  |  187 lines
  1. ;       Written by Avygdor Moise
  2. ;               York University
  3. ;               Rm 340 Petrie Building
  4. ;               Tel     667-3954
  5.  
  6. xref    printf_,getrec_,cnvif_,isdigit_,cnvf2s_,stoi_,fload_
  7. service_        set     $32
  8.  
  9. return  macr
  10.         clr     service_
  11.         rts
  12. endm
  13.  
  14.  
  15. ldu #$8000      ;allow lots of space for  data  stack...
  16.  
  17.         loop
  18.                 jsr     read            ;input an integer from terminal into 'd'
  19.         quif    eq
  20.                 jsr     fibonacci       ;call fibonacci with argument in D
  21.                 jsr     print           ;return result
  22.         endloop
  23.  
  24. return
  25.  
  26.  
  27. ; If   [D]         =  0 1 2 3 4 5 6  ....
  28. ; then [,U....3,u] =  1 1 2 3 5 8 13 ....
  29.  
  30. fibonacci   pshs    d                   ;save input parameter
  31.             cmpd    #2                  ;assume [d] = [a,b]  > 0
  32.             if      lt                  ;if     d < 2   then
  33.                     ldb     #1
  34.                     pshu    d
  35.                     clrb                ;       answer = 1
  36.                     pshu    d           ;
  37.             else                        ;else
  38.                     subd    #1          ;
  39.                     bsr     fibonacci   ;                fibonacci(D-1)
  40.                     subd    #1          ;                      +
  41.                     bsr     fibonacci   ;                fibonacci(D-2)
  42.                     bsr     double_add  ;       answer = --------------
  43.             endif                       ;endif
  44.                                         ;
  45.             puls    d                   ;restore input parameter unchanged
  46.     rts                                 ;return from subroutine
  47.  
  48. ;The following function will replace two 32 bit numbers on user stack
  49. ;by their sum.
  50.  
  51. double_add      ldd     2,u             ; D <--     Least Significant Word 1
  52.                 addd    6,u             ; D <-- D + Least Significant Word 2
  53.                 std     6,u             ; Least Significant Word 2 <-- D
  54.                                         ;
  55.                 ldd     4,u             ; D <--     Most  Significant Word 2
  56.                                         ;
  57.                 adcb    1,u             ;
  58.                 adca     ,u             ; D <-- D + Most  Significant Word 1
  59.                                         ;               + carry if any
  60.                 std     4,u             ; Most  Significant Word 2 <-- D
  61.                 leau    4,u             ;remove    Double Word from the stack
  62.         rts                             ;result is Double Word  on User stack
  63.  
  64. request_data    fcc     "%nEnter an integer please : "
  65.                 fcb     0
  66. buffer          rmb     81
  67.  
  68. read    equ     *       ;read a number from the terminal then
  69.                         ;return its 16 bit binary representation in Reg D
  70.  
  71.         ldd     #request_data
  72.         jsr     printf_
  73.  
  74.         ldd     #80
  75.         pshs    d                       ;argument = 'buffer length'
  76.         ldd     #buffer                 ;argument =  address of 'buffer'
  77.         jsr     getrec_                 ;get a line from terminal into 'buffer'
  78.         leas    2,s                     ;drop used argument 'buffer length'
  79.  
  80.         ldx     #buffer
  81.  
  82.         loop                            ;find the first digit
  83.                 pshs    b
  84.                 clra
  85.                 ldb     ,x+
  86.                 pshs    x
  87.                 jsr     isdigit_
  88.                 puls    x
  89.                 puls    b
  90.         quif    ne
  91.                 decb                    ;if not digit then reduce count by 1
  92.         until   eq                      ;quit if counter exhausted
  93.  
  94.         lbeq    read                    ;request another data
  95.  
  96.         leax    -1,x                    ;x points to start of data
  97.         clr     b,x                     ;convert data to string
  98.  
  99.         pshs    x
  100.         loop
  101.                 clra
  102.                 ldb     ,x+
  103.         quif    eq
  104.                 pshs    x
  105.                 jsr     isdigit_
  106.                 puls    x
  107.                 if      eq
  108.                         ldb     #$ff
  109.                 else
  110.                         clrb
  111.                 endif
  112.         until   ne
  113.         puls    x
  114.  
  115.         lbne    read            ;re-enter the data
  116.  
  117.         clr     5,x             ;make sure that there aren't too many digits
  118.         tfr     x,d
  119.         jsr     stoi_           ;d will contain the resulting integer
  120.  
  121.         rts
  122.  
  123. result  fcc     "%nFibonacci number = %s%n"
  124.         fcb 0
  125. answer  rmb     20
  126.  
  127. print   equ     *               ;print answer on ,U to terminal
  128.  
  129.         jsr     cnv_di_2f       ;convert double integer on U to float
  130.         tfr     u,d
  131.         jsr     fload_          ;transfer floating point number to acc1
  132.         leau    5,u             ;remove number off user stack
  133.  
  134.         ldd     #answer
  135.         pshs    d
  136.         jsr     cnvf2s_         ;answer$ = str$(acc1)
  137.  
  138.         ldd     #result
  139.         jsr     printf_
  140.         leas    2,s
  141.         rts
  142.  
  143. cnv_di_2f       equ     *       ;convert unsigned double integer to float
  144.  
  145. ;floating point format ....
  146.  
  147. ;       SEEEEEEE EMMMMMMM MMMMMMMM MMMMMMMM MMMMMMMM
  148.  
  149. ;       S = sign        1 = negative, 0 = positive
  150. ;       E = exponent in excess of 128
  151. ;       M = mantissa , left justified, first bit assumed to be 1
  152.  
  153.         ldb     #32             ;counter = 32 bits to convert
  154.                                 ;need to left justify number
  155.         loop
  156.                 tst     ,u      ;quit when most significant bit = 1
  157.         quif    lt
  158.                 asl     3,u     ; C <-- xxxxxxxx <-- 0
  159.                 rol     2,u     ; C <-- xxxxxxxx <-- C
  160.                 rol     1,u
  161.                 rol     0,u
  162.                                 ;effective result is a multiplication by two
  163.                                 ;so we need to adjust exponent later !!!
  164.                 decb
  165.         until   eq              ;all bits shifted ==> integer = 0
  166.  
  167.         if      ne              ;i.e. if b=0 then integer=0
  168.                 addb    #128    ;exponent in excess of 128
  169.                 asrb            ; S --> xxxxxxx --> C
  170.                 if      cs
  171.                         lda     #128
  172.                         ora     ,u
  173.                 else
  174.                         lda     #127
  175.                         anda    ,u
  176.                 endif
  177.                 sta     ,u
  178.                 andb    #127    ;remove sign bit
  179.                 pshu    b
  180.         else
  181.                 clr     ,-u
  182.         endif
  183.  
  184.         rts
  185.  
  186. end
  187.